home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL1NO3.ARC / SHTPT.LSP < prev    next >
Encoding:
Text File  |  1987-05-18  |  1.5 KB  |  40 lines
  1. (defun C:shtpt ()
  2. (if (= cirrad nil) (setq cirrad (getreal "Enter Shot Point Radius<0.04>: ")))
  3. (if (= cirrad nil) (setq cirrad 0.04))
  4. (setq sp1 (getint "Enter Beginning Shot Point No.: "))
  5. (setq spI (getint "Enter Numbering Interval: "))
  6. (if (= txsz nil) (setq txsz (getreal "Enter Text Size<0.08>: ")))
  7. (if (= txsz nil) (setq txsz 0.08))
  8. (setq loc1 (getpoint "Where? "))
  9. (command "layer" "set" 1)
  10. (command "")
  11. (command "circle" loc1 cirrad)
  12. (setq loc2 (getpoint "Where? "))
  13. (setq wiz (angle loc1 loc2))
  14. (setq ttl (distance loc1 loc2))
  15. (setq new1 (polar loc1 wiz cirrad))
  16. (setq lindist (- ttl (* cirrad 2)))
  17. (setq new2 (polar new1 wiz lindist))
  18. (setq txptang (- wiz 0.5236))
  19. (setq txptdist (+ cirrad 0.02))
  20. (setq txpt1 (polar loc1 txptang txptdist))
  21. (setq txan (angtos (- wiz 1.57) 0 0))
  22. (command "text" txpt1 txsz txan sp1)
  23. (setq sp2 (+ sp1 spI))
  24. (command "line" new1 new2)
  25. (command "")
  26. (command "circle" loc2 cirrad)
  27. (setq l t)
  28. (while l (setq loc1 loc2) (setq loc2 (getpoint "Where?: "))
  29.    (setq wiz (angle loc1 loc2)) (setq ttl (distance loc1 loc2))
  30.    (setq new1 (polar loc1 wiz cirrad))
  31.    (setq lindist (- ttl (* cirrad 2)))
  32.    (setq new2 (polar new1 wiz lindist))
  33.    (setq txptang (- wiz 0.5236))
  34.    (setq txpt1 (polar loc1 txptang txptdist))
  35.    (setq sp2 (+ sp1 spI)) (setq txan (angtos (- wiz 1.57) 0 0))
  36.    (command "text" txpt1 txsz txan sp2) (setq sp1 sp2)
  37.    (command "line" new1 new2)
  38.    (command "") (command "circle" loc2 cirrad))
  39. )
  40.